Shareware Grab Bag/Shareware Grab Bag.iso/007/date.arc/INCDAY.PAS

Pascal/Delphi Source File | 1984-01-01 | 7.7 KB | 310 lines

PROGRAM Set_Date(INPUT,OUTPUT,DataFile);
{
     This program keeps track of the date from the last time it was set
     using this procedure. The user is given the option of setting the
     time in a format similar to the DOS date function; the other allows
     the date to be set by incrementing the day, one day at a time.
     By Tim MacNary (1984).

     When Compiling this using Turbo Pascal, set the Maximum and Minumum
     Dynamic Heap size down to 100 so that the program does not displace
     the operating system.
}
CONST
     Debug=FALSE;
TYPE
     RegType=RECORD
          AX,BX,CX,DX,BP,SI,DI,DS,ES,Flags:INTEGER;
     END;

VAR
     CheckProgram:FILE;
     DataFile:FILE OF RegType;
     Reg,Temp:RegType;
     GoodDate:BOOLEAN;
     OK:BOOLEAN;
     Choice:CHAR;

PROCEDURE ReadFile(VAR Reg:RegType);
{an ASSIGN must have been previously performed}

BEGIN
     {$I-}RESET(DataFile);{$I+};
     IF IOResult<>0 THEN { Error occurred; file does'nt exist on this disk.}
     BEGIN
          Reg.DX:=$101; { Set up some defaults for month, day, and year. }
          Reg.CX:=1984
     END
     ELSE READ(DataFile,Reg); { Read in register settings }
END;

PROCEDURE WriteFile(Reg:RegType);
BEGIN
     IF Debug THEN WRITELN('IN WriteFile');
     REWRITE(DataFile);
     WRITE(DataFile,Reg);
     CLOSE(DataFile)
END;

PROCEDURE CurseOff;
VAR
   result : RECORD
          ax,bx,cx,dx,bp,si,di,ds,es,flags:integer;
          END;
BEGIN
     IF mem[$0000:$0449] = 7 THEN
          result.cx :=$4000
     ELSE
          result.cx:=$2000;
     result.ax:=$0100;
     INTR($10,result);
END;

PROCEDURE CurseNorm;
VAR
   result : RECORD
          ax,bx,cx,dx,bp,si,di,ds,es,flags:integer;
          END;
BEGIN
     IF mem[$0000:$0449] = 7 THEN
          result.cx :=$0b0c
     ELSE
          result.cx:=$0707;
     result.ax:=$0100;
     INTR($10,result);
END;

PROCEDURE PrintMonth(Num:INTEGER);
BEGIN
     CASE Num OF
          1:WRITE('January');
          2:WRITE('Febuary');
          3:WRITE('March');
          4:WRITE('April');
          5:WRITE('May');
          6:WRITE('June');
          7:WRITE('July');
          8:WRITE('August');
          9:WRITE('September');
          10:WRITE('October');
          11:WRITE('November');
          12:WRITE('December')
     END;
END;

PROCEDURE PrintDate(REg:RegType);
BEGIN
     PrintMonth(HI(Reg.DX));
     WRITE(' ',LO(Reg.DX),',',Reg.CX)
END;

PROCEDURE GetChoice(VAR CH:CHAR;Register:RegType);
VAR
     Reg:RECORD
          AX,BX,CX,DX,BP,SI,DI,DS,ES,Flags:INTEGER;
     END;

BEGIN
     ClrScr;
     GotoXY(33,9);
     PrintDate(Register);
     GotoXY(33,11);
     WRITE('      MENU');
     GotoXY(33,12);
     NormVideo;
     WRITE('C');
     LowVideo;
     WRITE('hange year, month and day');
     GotoXY(33,13);
     NormVideo;
     WRITE('I');
     LowVideo;
     WRITE('ncrement day, one day at time');
     GotoXY(33,14);
     NormVideo;
     WRITE('E');
     LowVideo;
     WRITELN('xit with shown date');
     GotoXY(33,15);
     WRITE('Choice > ');

     { Read single character input }
     Reg.AX:=$100;
     INTR($21,Reg);
     CH:=UPCASE(LO(Reg.AX));

END;

PROCEDURE SetDate(VAR Reg:RegType;VAR Good:BOOLEAN);
BEGIN
     IF Debug THEN WRITELN('IN SetDate');
     Reg.AX:=$2B00;
     INTR($21,Reg)
END;

PROCEDURE IncrementDay(VAR Reg:RegType;VAR Good:BOOLEAN);
VAR
     Month,Day,Year,NumDays:INTEGER;
     CH:CHAR;

     FUNCTION Days_In_Month(Month:INTEGER):INTEGER;
     BEGIN
          CASE Month OF
               9,4,6,11:Days_In_Month:=30;
               2:Days_In_Month:=28;
               ELSE Days_In_Month:=31
          END
     END;

BEGIN
     IF Debug THEN WRITELN('IN IncrementDay');
     WITH Reg DO
     BEGIN
          Month:=HI(DX);
          Year:=CX;
          Day:=LO(DX)
     END;
     NumDays:=Days_In_Month(Month);
     ClrScr;

     GotoXY(22,24);
     WRITE('Hold down the <Space> key to increment day');
     GotoXY(15,25);
     WRITE('Press <Esc> to abort ; Press any other key to update date');
     GotoXY(37,12);
     WRITE(Month,'/',Day,'/',Year,'     ');
     REPEAT    {UNTIL CH<>' '}
          Reg.AX:=$800;
          INTR($21,Reg);              {Input from keyboard without echo}
          CH:=CHAR(LO(Reg.AX));
          IF CH=' ' THEN
          BEGIN
               Day:=Day+1;
               IF Day>NumDays THEN
               BEGIN
                    Day:=1;
                    Month:=Month+1;
                    IF Month>12 THEN
                    BEGIN
                         GotoXY(30,1);
                         WRITE('H A P P Y  N E W  Y E A R');
                         Month:=1;
                         NumDays:=Days_In_Month(Month);
                         Year:=Year+1;
                    END
               END;
               GotoXY(37,12);
               WRITE(Month,'/',Day,'/',Year,'     ');
          END;
     UNTIL CH<>' ';
     GotoXY(13,24);
     WRITE('                                                           ');
     GotoXY(13,25);
     IF ORD(CH)<>27 THEN
     BEGIN
          WRITE('                     DATE UPDATED                           ');
          Good:=TRUE
     END
     ELSE BEGIN
          WRITE('                    DATE UNCHANGED                          ');
          Good:=FALSE
     END;
     WITH Reg DO
     BEGIN
          CX:=Year;
          DX:=(Month SHL 8)+Day
     END;
END;

PROCEDURE SetEntireDate(VAR Reg:RegType;VAR OK:BOOLEAN);
VAR
     Year,Month,Day:INTEGER;
BEGIN
     IF DEBUG THEN WRITELN('IN SetEntireDate');
     ClrScr;
     WITH Reg DO
     BEGIN
          Month:=HI(DX);
          Year:=CX;
          Day:=LO(DX)
     END;

     {Set year}
     GotoXY(24,11);
     WRITE('Current setting > ',Year,'  ');
     GotoXY(30,12);
     WRITE(' New Year > 19');
     READLN(Year);
     Year:=Year+1900;

     {Set month}
     GotoXY(24,11);
     WRITE('Current setting > ',Month,'  (');
     PrintMonth(Month);
     WRITE(')');
     GotoXY(30,12);
     WRITE('New Month >                     ');
     GotoXY(42,12);
     READLN(Month);

     {Set day}
     GotoXY(24,11);
     WRITE('Current setting > ',Day,'                     ');
     GotoXY(30,12);
     WRITE('  New Day >                      ');
     GotoXY(42,12);
     READLN(Day);
     IF Debug THEN WRITE('Year>',Year,'Month>',Month,'Day>',Day);
     GotoXY(30,25);
     IF (Year>0) AND (Month>0) AND (Month<=12) AND (Day>0) AND (Day<=31) THEN
     WITH Reg DO
     BEGIN
          Ok:=TRUE;
          GotoXY(35,25);
          WRITE('DATE UPDATED');
          CX:=Year;
          DX:=(Month SHL 8)+Day
     END
     ELSE BEGIN
          WRITE('DATE UNCHANGED');
          Ok:=FALSE
     END
END;

BEGIN
     LowVideo;
     GoodDate:=TRUE;
     ASSIGN(DataFile,'DATE.DAT');

     ReadFile(Reg);
     Temp:=Reg;         {Save current settings}
     CurseOff;

     REPEAT
          GetChoice(Choice,Reg);
          CASE Choice OF
               'C':SetEntireDate(Reg,Ok);
               'I':IncrementDay(Reg,Ok);
               'E':BEGIN
                        NormVideo;
                        GotoXY(30,25);
                        WRITE('Exiting...');
                        Ok:=FALSE
                    END;
               ELSE BEGIN
                    GotoXY(30,15);
                    WRITE('Please enter an "C" or an "I"   ');
                    Delay(2000)
               END;
          END
     UNTIL Choice IN ['C','I','E'];

     CurseNorm;
     IF OK THEN
     BEGIN
          SetDate(Reg,GoodDate);
          WriteFile(Reg)
     END
     ELSE
          SetDate(Temp,GoodDate);
END.